home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d16 / wx60win.arc / WX51.BAS < prev    next >
BASIC Source File  |  1991-06-30  |  23KB  |  558 lines
  1. 10 REM
  2. 20 REM      WEATHER FORECAST PROGRAM by Phil Baughn
  3. 30 REM
  4. 40 REM      This software program is distributed as "SHAREWARE".  You may
  5. 50 REM      feel free to copy and revise it as you like as long as you do
  6. 60 REM      not alter or remove the credit information in the program. If
  7. 70 REM      you find that you have made some significant improvements and
  8. 80 REM      additions to this package, please upload them to my attention
  9. 90 REM      either at The MAILROOM RBBS or to Compuserve; User#76044,1535.
  10. 100 REM      Enjoy!    Phil Baughn
  11. 110 REM
  12. 120 REM     Mailing address:          The MAILROOM RBBS-PC
  13. 130 REM                               attn.  Phil Baughn
  14. 140 REM                               2050 Idle Hour Center
  15. 150 REM                               Lexington, KY  40502
  16. 160 REM                               Data:  (606)293-5119
  17. 170 REM                               Voice: (606)268-0206
  18. 180 REM
  19. 190 REM     Special Credit to Mssrs. Bernard N. Meisner and Leon F. Graves
  20. 200 REM     who developed the Heat Index / Apparent Temperature Formula.
  21. 210 REM
  22. 220 REM     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  23. 230 REM
  24. 240 REM     BELOW TURNS KEYS OFF, SELECTS COLOR OR MONO, TURNS CAPS ON
  25. 250 REM
  26. 260 DEF SEG=0:POKE 1047,96:DEF SEG
  27. 270 KEY OFF:CLS:LOCATE 10,23:INPUT "Do you want Color? (Y)es or (N)o";CLRANS$
  28. 280 IF LEFT$(CLRANS$,1)="Y" OR LEFT$(CLRANS$,1)="y" THEN CLRT$="Y":GOTO 330
  29. 290 IF LEFT$(CLRANS$,1) <> "N" AND LEFT$(CLRANS$,1) <> "n" THEN GOTO 270
  30. 300 CLRT$ = " "
  31. 310 REM
  32. 320 REM
  33. 330 GOSUB 1040
  34. 340 REM     GET WELCOME SCREEN AND CREDITS IN ABOVE LINE
  35. 350 REM     GET MASTER WELCOME DOCUMENT IN FOLLOWING LINE
  36. 360 GOSUB 1330
  37. 370 REM
  38. 380 REM     PRINT MAIN MENU
  39. 390 REM
  40. 400 CLS:IF CLRT$ = "Y" THEN COLOR 14
  41. 410 LOCATE 9,20:PRINT "1 - WEATHER FORECAST PROGRAM"
  42. 420 IF CLRT$ = "Y" THEN COLOR 11
  43. 430 LOCATE 11,20:PRINT "2 - WIND CHILL CALCULATION"
  44. 440 IF CLRT$ = "Y" THEN COLOR 12
  45. 450 LOCATE 13,20:PRINT "3 - TEMPERATURE HUMIDITY INDEX"
  46. 460 IF CLRT$ = "Y" THEN COLOR 13
  47. 470 LOCATE 15,20:PRINT "4 - HEAT INDEX CALCULATION"
  48. 480 IF CLRT$ = "Y" THEN COLOR 14
  49. 490 LOCATE 17,20:PRINT "5 - DEW POINT CALCULATION"
  50. 500 IF CLRT$ = "Y" THEN COLOR 9
  51. 510 LOCATE 5,5:INPUT "ENTER THE NUMBER OF THE WEATHER PROGRAM WHICH YOU WISH TO RUN  ";CHOICE
  52. 520 REM
  53. 530 REM     GET FORCASTING SUNROUTINE
  54. 540 REM
  55. 550 IF CHOICE=1 THEN GOSUB 1650 ELSE GOTO 600
  56. 560 GOTO 790
  57. 570 REM
  58. 580 REM     GET WIND CHILL SUBROUTINE
  59. 590 REM
  60. 600 IF CHOICE=2 THEN GOSUB 3290 ELSE GOTO 650
  61. 610 GOTO 790
  62. 620 REM
  63. 630 REM     GET TEMP-HUMIDITY SUBROUTINE
  64. 640 REM
  65. 650 IF CHOICE=3 THEN GOSUB 4710 ELSE GOTO 700
  66. 660 GOTO 790
  67. 670 REM
  68. 680 REM     GET HEAT INDEX SUBROUTINE
  69. 690 REM
  70. 700 IF CHOICE=4 THEN GOSUB 3610 ELSE GOTO 750
  71. 710 GOTO 790
  72. 720 REM
  73. 730 REM     GET DEW POINT SUBROUTINE
  74. 740 REM
  75. 750 IF CHOICE=5 THEN GOSUB 5230 ELSE GOTO 400
  76. 760 REM
  77. 770 REM     LOOP OR QUIT
  78. 780 REM
  79. 790 LOCATE 24,14:INPUT "DO YOU WISH TO DO A DIFFERENT CALCULATION (Y/N)";D$
  80. 800 REM
  81. 810 REM     LOOP
  82. 820 REM
  83. 830 IF D$="Y" OR D$="y" THEN GOTO 400
  84. 840 REM
  85. 850 REM     QUIT WITH EPILOG SCREEN AND RESET IF CLRT$="Y" THEN COLORS TO NORMAL
  86. 860 REM     ALSO PLACE CAPS AND NUMBERS LOCK KEYS BACK TO OFF STATUS
  87. 870 REM
  88. 880 IF CLRT$ = "Y" THEN COLOR 12,0,0
  89. 890 CLS:LOCATE 9,23:PRINT "I hope you enjoyed WEATHER and"
  90. 900 LOCATE 11,21:PRINT "that your forecast was a good one."
  91. 910 LOCATE 15,20:PRINT "Let us here from you on The MAILROOM"
  92. 920 LOCATE 17,18:PRINT "Data (606)293-5119 - 9600 Baud Supported"
  93. 930 LOCATE 19,37:PRINT "- Phil Baughn"
  94. 940 DEF SEG=0:POKE 1047,0:DEF SEG
  95. 950 IF CLRT$ = "Y" THEN COLOR 7,0,0
  96. 960 LOCATE 24,1
  97. 970 END
  98. 980 REM     ~~~~~~~~~~~~~~PROGRAM ENDS HERE~~~~~~~~~~~~~~
  99. 990 REM
  100. 1000 REM     ~~~~~~~~SUBROUTINE MODULES BEGIN HERE~~~~~~~~
  101. 1010 REM
  102. 1020 REM     WELCOME SCREEN AND CREDITS SUBROUTINE
  103. 1030 REM
  104. 1040 CLS
  105. 1050 WIDTH 80:IF CLRT$ = "Y" THEN COLOR 11,0
  106. 1060 LOCATE 5,5:PRINT CHR$(201):LOCATE 5,75:PRINT CHR$(187)
  107. 1070 LOCATE 20,5:PRINT CHR$(200):LOCATE 20,75:PRINT CHR$(188)
  108. 1080 FOR N=6 TO 19
  109. 1090 LOCATE N,5:PRINT CHR$(186)
  110. 1100 LOCATE N,75:PRINT CHR$(186)
  111. 1110 NEXT N
  112. 1120 FOR N=6 TO 74
  113. 1130 LOCATE 5,N:PRINT CHR$(205)
  114. 1140 LOCATE 20,N:PRINT CHR$(205)
  115. 1150 NEXT N
  116. 1160 IF CLRT$ = "Y" THEN COLOR 13,0
  117. 1170 LOCATE 7,31:PRINT "WEATHER FORCASTING"
  118. 1180 LOCATE 9,28:PRINT "DEVELOPED FOR THE IBM-PC"
  119. 1190 LOCATE 10,39:PRINT "BY"
  120. 1200 LOCATE 11,35:PRINT "PHIL BAUGHN"
  121. 1210 LOCATE 13,14:PRINT "Special Thanks For Module Improvements To Sean Gayle,"
  122. 1220 LOCATE 14,11:PRINT "John Fleming, & Brad James - Meteorologist, WKYT, Lexington"
  123. 1230 LOCATE 16,20:PRINT "Distributed Through The MAILROOM RBBS-PC"
  124. 1240 LOCATE 17,29:PRINT "In Lexington, Kentucky"
  125. 1250 LOCATE 18,22:PRINT "(606)293-5119   24 Hours - 9600 Baud"
  126. 1260 LOCATE 19,21:PRINT "Latest Revision [ 5.1 ];  January 1987"
  127. 1261 LOCATE 22,27:PRINT "Press any key when ready..."
  128. 1262 IF INKEY$ ="" GOTO 1262
  129. 1270 IF CLRT$ = "Y" THEN COLOR 7,0,0
  130. 1280 CLS
  131. 1290 RETURN
  132. 1300 REM
  133. 1310 REM     MAIN WELCOME DOCUMENT SUBROUTINE
  134. 1320 REM
  135. 1330 IF CLRT$ = "Y" THEN COLOR 14,1,1
  136. 1340 CLS
  137. 1350 PRINT "  "
  138. 1360 PRINT "  "
  139. 1370 PRINT "    This  program  will provide  you with a very good forcast providing"
  140. 1380 PRINT "    you supply the correct  information  as to barometric  pressure and"
  141. 1390 PRINT "    wind direction.  This method has been used  for ages  by  sailors &"
  142. 1400 PRINT "    the tables  themselves can still be found in  almost  all  editions"
  143. 1410 PRINT "    of The Farmers Almanac."
  144. 1420 PRINT " "
  145. 1430 PRINT "    The other four programs which are included at present;  Wind Chill,"
  146. 1440 PRINT "    Dew Point, Temp/Humidity, & Heat Index; can be especially important"
  147. 1450 PRINT "    when working outdoors.  Wind Chill tells you the true  FEEL  of the"
  148. 1460 PRINT "    temperature  after the wind has it's effect.   It's not always safe"
  149. 1470 PRINT "    to simply  look  at the outdoor thermometer!  Humidity also effects"
  150. 1480 PRINT "    the temperature.   Higher humidity  levels  cause it to effect your"
  151. 1490 PRINT "    body as if it were hotter than the thermometer states."
  152. 1500 PRINT "  "
  153. 1510 PRINT "    Enjoy the program,   please pass along any  improvements  which you"
  154. 1520 PRINT "    may develop  or  additional  modules  which will fit well into  the"
  155. 1530 PRINT "    menu.   Listing  the  programs, lines 1-200, [ ie- LIST -200 ] will"
  156. 1540 PRINT "    provide you with more detailed contact information."
  157. 1550 PRINT "  "
  158. 1560 PRINT "  "
  159. 1570 PRINT "    Press any key when ready..."
  160. 1580 IF INKEY$ ="" GOTO 1580
  161. 1590 IF CLRT$ = "Y" THEN COLOR 7,0,0
  162. 1600 CLS
  163. 1610 RETURN
  164. 1620 REM
  165. 1630 REM     WIND-BAROMETER FORECASTING SUBROUTINE
  166. 1640 REM
  167. 1650 CLS:IF CLRT$ = "Y" THEN COLOR 14
  168. 1660 LOCATE 2,25:PRINT "WEATHER FORECAST PROGRAM"
  169. 1670 IF CLRT$ = "Y" THEN COLOR 5
  170. 1680 LOCATE 4,32:PRINT DATE$:LOCATE 5,33:PRINT TIME$
  171. 1690 IF CLRT$ = "Y" THEN COLOR 3,0,0
  172. 1700 KEY OFF:LOCATE 7,12
  173. 1710 INPUT "ENTER CURRENT BAROMETRIC PRESSURE                  ";CBP
  174. 1720 IF CBP<25 THEN 1700
  175. 1730 IF CBP>35 THEN 1700
  176. 1740 LOCATE 8,12
  177. 1750 INPUT "WIND DIRECTION IS CURRENTLY FROM THE               ";PWD$
  178. 1760 IF PWD$="SW" THEN 1770 ELSE 1800
  179. 1770 LOCATE 9,12
  180. 1780 INPUT "PREVIOUS WIND DIRECTION WAS FROM THE               ";PWD$
  181. 1790 GOTO 1930
  182. 1800 IF PWD$="SE" THEN 1810 ELSE 1840
  183. 1810 LOCATE 9,12
  184. 1820 INPUT "PREVIOUS WIND DIRECTION WAS FROM THE               ";PWD$
  185. 1830 GOTO 2010
  186. 1840 IF PWD$="S" THEN 1880 ELSE 1850
  187. 1850 IF PWD$="N" THEN 1880 ELSE 1860
  188. 1860 IF PWD$="NW" THEN 1880 ELSE 1870
  189. 1870 IF PWD$="NE" THEN 1880 ELSE 2090
  190. 1880 LOCATE 18,23
  191. 1890 IF CLRT$ = "Y" THEN COLOR 9
  192. 1900 PRINT "NO IMMEDIATE CHANGE IS FORECAST"
  193. 1910 IF CLRT$ = "Y" THEN COLOR 7,0,0
  194. 1920 GOTO 3220
  195. 1930 IF PWD$="S" THEN 1950 ELSE 1940
  196. 1940 IF PWD$="NW" THEN 1970 ELSE 1990
  197. 1950 PWD$="M"
  198. 1960 GOTO 2140
  199. 1970 PWD$="N"
  200. 1980 GOTO 2140
  201. 1990 PWD$="O"
  202. 2000 GOTO 2140
  203. 2010 IF PWD$="NE" THEN 2030 ELSE 2020
  204. 2020 IF PWD$="S" THEN 2050 ELSE 2070
  205. 2030 PWD$="P"
  206. 2040 GOTO 2140
  207. 2050 PWD$="Q"
  208. 2060 GOTO 2140
  209. 2070 PWD$="R"
  210. 2080 GOTO 2140
  211. 2090 IF PWD$="E" THEN 2110 ELSE 2100
  212. 2100 IF PWD$="W" THEN 2130
  213. 2110 PWD$="S"
  214. 2120 GOTO 2140
  215. 2130 PWD$="T"
  216. 2140 IF CLRT$ = "Y" THEN COLOR 4
  217. 2150 LOCATE 13,12:PRINT "WIND CONDITION CODE IS ",PWD$;
  218. 2160 IF CLRT$ = "Y" THEN COLOR 3,0,0
  219. 2170 IF CBP>30.01 THEN 2340 ELSE 2180
  220. 2180 IF CBP<29.81 THEN 2490 ELSE 2190
  221. 2190 LOCATE 10,12
  222. 2200 INPUT "IS PRESSURE RISING (R), FALLING (F), OR STEADY (S) ";BM$
  223. 2210 IF BM$="F" THEN 2220 ELSE 2290
  224. 2220 LOCATE 11,12
  225. 2230 INPUT "IS IT FALLING RAPIDLY (R) OR SLOWLY (S)            ";BM$
  226. 2240 IF BM$="R" THEN 2250 ELSE 2270
  227. 2250 BM$="C6"
  228. 2260 GOTO 2560
  229. 2270 BM$="C5"
  230. 2280 GOTO 2560
  231. 2290 IF BM$="R" THEN 2300 ELSE 2320
  232. 2300 BM$="C7"
  233. 2310 GOTO 2560
  234. 2320 BM$="C0"
  235. 2330 GOTO 2560
  236. 2340 LOCATE 10,12
  237. 2350 INPUT "IS PRESSURE RISING (R), FALLING (F), OR STEADY (S) ";BM$
  238. 2360 IF BM$="F" THEN 2370 ELSE 2440
  239. 2370 LOCATE 11,12
  240. 2380 INPUT "IS IT FALLING RAPIDLY (R) OR SLOWLY (S)            ";BM$
  241. 2390 IF BM$="R" THEN 2400 ELSE 2420
  242. 2400 BM$="C4"
  243. 2410 GOTO 2560
  244. 2420 BM$="C3"
  245. 2430 GOTO 2560
  246. 2440 IF BM$="S" THEN 2450 ELSE 2470
  247. 2450 BM$="C1"
  248. 2460 GOTO 2560
  249. 2470 BM$="C2"
  250. 2480 GOTO 2560
  251. 2490 LOCATE 10,12
  252. 2500 INPUT "IS THE PRESSURE RISING (R) OR FALLING (F)          ";BM$
  253. 2510 IF BM$="R" THEN 2520 ELSE 2540
  254. 2520 BM$="C8"
  255. 2530 GOTO 2560
  256. 2540 BM$="C9"
  257. 2550 GOTO 2560
  258. 2560 IF CLRT$ = "Y" THEN COLOR 4
  259. 2570 LOCATE 14,12:PRINT "BAROMETRIC CODE IS ",BM$
  260. 2580 IF CLRT$ = "Y" THEN COLOR 3,0,0
  261. 2590 IF PWD$="O" THEN 1880
  262. 2600 IF PWD$="R" THEN 1880
  263. 2610 LOCATE 17,18:PRINT "PLEASE WAIT - FORECAST BEING COMPUTED"
  264. 2620 FOR X=1 TO 3200:NEXT X
  265. 2630 LOCATE 17,18:PRINT "                                                 "
  266. 2640 IF PWD$="T" AND BM$="C8" THEN 2840
  267. 2650 IF PWD$="M" AND BM$="C7" THEN 2860
  268. 2660 IF PWD$="Q" AND BM$="C3" THEN 2890
  269. 2670 IF PWD$="Q" AND BM$="C4" THEN 2910
  270. 2680 IF PWD$="Q" AND BM$="C9" THEN 2930
  271. 2690 IF PWD$="P" AND BM$="C3" THEN 2960
  272. 2700 IF PWD$="P" AND BM$="C4" THEN 2980
  273. 2710 IF PWD$="P" AND BM$="C5" THEN 2990
  274. 2720 IF PWD$="P" AND BM$="C6" THEN 3010
  275. 2730 IF PWD$="P" AND BM$="C9" THEN 2930
  276. 2740 IF PWD$="S" AND BM$="C3" THEN 3040
  277. 2750 IF PWD$="S" AND BM$="C4" THEN 3070
  278. 2760 IF PWD$="S" AND BM$="C9" THEN 3120
  279. 2770 IF PWD$="N" AND BM$="C1" THEN 3150
  280. 2780 IF PWD$="N" AND BM$="C2" THEN 3180
  281. 2790 IF PWD$="N" AND BM$="C3" THEN 3200
  282. 2800 IF PWD$="N" AND BM$="C7" THEN 2860
  283. 2810 LOCATE 17,20:IF CLRT$ = "Y" THEN COLOR 13
  284. 2820 PRINT "WIND INCREASING; RAIN WITHIN 12 HOURS":GOTO 3220
  285. 2830 GOTO 1880
  286. 2840 LOCATE 17,30:IF CLRT$ = "Y" THEN COLOR 13
  287. 2850 PRINT "CLEARING AND COLDER":GOTO 3220
  288. 2860 LOCATE 17,20:IF CLRT$ = "Y" THEN COLOR 13
  289. 2870 PRINT "CLEARING WITHIN A FEW HOURS/"
  290. 2880 LOCATE 19,20:PRINT "FAIR FOR SEVERAL DAYS":GOTO 3220
  291. 2890 LOCATE 17,30:IF CLRT$ = "Y" THEN COLOR 13
  292. 2900 PRINT "RAIN WITHIN 24 HOURS":GOTO 3220
  293. 2910 LOCATE 17,20:IF CLRT$ = "Y" THEN COLOR 13
  294. 2920 PRINT "WIND INCREASING; RAIN WITHIN 24 HOURS":GOTO 3220
  295. 2930 LOCATE 17,15:IF CLRT$ = "Y" THEN COLOR 15
  296. 2940 PRINT "SEVERE STORM IMMIMENT, FOLLOWED WITHIN 24 HOURS"
  297. 2950 LOCATE 19,15:PRINT "BY CLEARING. IN WINTER, COLDER TEMPERATURES.":GOTO 3220
  298. 2960 LOCATE 17,30:IF CLRT$ = "Y" THEN COLOR 13
  299. 2970 PRINT "RAIN WITHIN 12 TO 18 HOURS":GOTO 3220
  300. 2980 LOCATE 17,20:IF CLRT$ = "Y" THEN COLOR 13
  301. 2990 LOCATE 17,20:IF CLRT$ = "Y" THEN COLOR 13
  302. 3000 PRINT "RAIN WILL CONTINUE FOR 1 TO 2 DAYS":GOTO 3220
  303. 3010 LOCATE 17,15:IF CLRT$ = "Y" THEN COLOR 13
  304. 3020 PRINT "RAIN, WITH HIGH WIND, FOLLOWED WITHIN 36 HOURS BY"
  305. 3030 LOCATE 19,15:PRINT "CLEARING. IN WINTER - COLDER TEMPERATURES.":GOTO 3220
  306. 3040 LOCATE 17,15:IF CLRT$ = "Y" THEN COLOR 13
  307. 3050 PRINT "SUMMER - LIGHT WINDS; RAIN MAY NOT FALL FOR"
  308. 3060 LOCATE 19,15:PRINT "SEVERAL DAYS.  WINTER - RAIN WITHIN 24 HOURS":GOTO 3220
  309. 3070 LOCATE 17,15:IF CLRT$ = "Y" THEN COLOR 13
  310. 3080 PRINT "SUMMER RAIN PROBABLE 12/24 HOURS.  WINTER"
  311. 3090 LOCATE 19,15:PRINT "RAIN OR SNOW, INCREASING WIND; BAD WEATHER"
  312. 3100 LOCATE 21,15:PRINT "OFTEN SETS IN WHEN BAROMETER BEGINS TO FALL AND"
  313. 3110 LOCATE 23,15:PRINT "WINDS SET IN FROM THE NORTHEAST.":GOTO 3220
  314. 3120 LOCATE 17,15:IF CLRT$ = "Y" THEN COLOR 15
  315. 3130 PRINT "SEVERE NORTHEAST GALE AND HEAVY PRECIPITATION,"
  316. 3140 LOCATE 19,15:PRINT "IN WINTER - HEAVY SNOW FOLLOWED BY A COLD WAVE":GOTO 3220
  317. 3150 LOCATE 17,20:IF CLRT$ = "Y" THEN COLOR 13
  318. 3160 PRINT "CONTINUED FAIR WEATHER WITH"
  319. 3170 LOCATE 19,20:PRINT "NO DECIDED TEMPERATURE CHANGE":GOTO 3220
  320. 3180 LOCATE 17,20:IF CLRT$ = "Y" THEN COLOR 13
  321. 3190 PRINT "FAIR, FOLLOWED WITHIN 2 DAYS BY RAIN":GOTO 3220
  322. 3200 LOCATE 17,15:IF CLRT$ = "Y" THEN COLOR 13
  323. 3210 PRINT "FAIR FOR 2 DAYS WITH SLOWLY RISING TEMPERATURES"
  324. 3220 IF CLRT$ = "Y" THEN COLOR 7,0,0
  325. 3230 LOCATE 24,17:INPUT "DO YOU WISH TO RUN ANOTHER FORECAST (Y/N)";L$
  326. 3240 IF L$="Y" OR L$="y" THEN GOTO 1650
  327. 3250 RETURN
  328. 3260 REM
  329. 3270 REM     WIND CHILL SUBROUTINE
  330. 3280 REM
  331. 3290 CLS:IF CLRT$ = "Y" THEN COLOR 11
  332. 3300 LOCATE 2,27:PRINT "WIND CHILL CALCULATION"
  333. 3310 IF CLRT$ = "Y" THEN COLOR 5
  334. 3320 LOCATE 4,34:PRINT DATE$:LOCATE 5,35:PRINT TIME$
  335. 3330 IF CLRT$ = "Y" THEN COLOR 3,0,0
  336. 3340 KEY OFF:LOCATE 7,12
  337. 3350 INPUT "ENTER TEMPERATURE IN FAHRENHEIT                    ";T
  338. 3360 LOCATE 8,12
  339. 3370 INPUT "ENTER WIND SPEED IN MILES PER HOUR                 ";V
  340. 3380 T1=T:V=(V*1609.35)/(3600):TC=33-((T-32)*(5/9))
  341. 3390 H=(10.45+(SQR(V)*10)-V)*TC:X=H-506.784
  342. 3400 IF X<0 THEN X1=T1:GOTO 3520
  343. 3410 X1=50-(X/12.3):X1=INT(((X1*10)+5)/10)
  344. 3420 IF CLRT$ = "Y" THEN COLOR 3
  345. 3430 LOCATE 11,19:PRINT "PLEASE WAIT - WIND CHILL BEING COMPUTED"
  346. 3440 FOR ZZ=1 TO 1600:NEXT ZZ
  347. 3450 IF CLRT$ = "Y" THEN COLOR 4
  348. 3460 LOCATE 13,17:PRINT "T1=T:V=(V*1069.35)/3600:TC=33-((T-32)*(5/9))"
  349. 3470 FOR Z=1 TO 800:NEXT Z
  350. 3480 LOCATE 14,20:PRINT "H=(10.45+(SQR(V)*10)-V)*TC:X=H-506.784"
  351. 3490 FOR ZXC=1 TO 800:NEXT ZXC
  352. 3500 LOCATE 15,21:PRINT "X1=50-(X/12.3):X1=INT(((X1*10)+5)/10)"
  353. 3510 FOR ZX=1 TO 1600:NEXT ZX
  354. 3520 IF CLRT$ = "Y" THEN COLOR 13
  355. 3530 LOCATE 19,15:PRINT "WIND CHILL TEMPERATURE = ";X1;"DEGREES FAHRENHEIT"
  356. 3540 IF CLRT$ = "Y" THEN COLOR 7,0,0
  357. 3550 LOCATE 24,19:INPUT "RUN ANOTHER WIND CHILL FACTOR (Y/N)";L$
  358. 3560 IF L$="Y" OR L$="y" THEN GOTO 3290
  359. 3570 RETURN
  360. 3580 REM
  361. 3590 REM     HEAT INDEX SUBROUTINE
  362. 3600 REM
  363. 3610 CLS:IF CLRT$ = "Y" THEN COLOR 11
  364. 3620 LOCATE 2,27:PRINT "HEAT INDEX CALCULATION"
  365. 3630 IF CLRT$ = "Y" THEN COLOR 5
  366. 3640 LOCATE 4,34:PRINT DATE$:LOCATE 5,35:PRINT TIME$
  367. 3650 IF CLRT$ = "Y" THEN COLOR 3,0,0
  368. 3660 KEY OFF:LOCATE 7,11
  369. 3670 INPUT "ENTER THE CURRENT TEMPERATURE IN DEGREES FAHRENHEIT ";TA
  370. 3680 U$="F"
  371. 3690 LOCATE 8,11
  372. 3700 INPUT "ENTER THE RELATIVE HUMIDITY  (`50'= 50% )           ";RH
  373. 3710 IF CLRT$ = "Y" THEN COLOR 9
  374. 3720 LOCATE 11,18:PRINT "PLEASE WAIT - HEAT INDEX BEING COMPUTED"
  375. 3730 FOR ZZ=1 TO 1600:NEXT ZZ
  376. 3740 IF CLRT$ = "Y" THEN COLOR 4
  377. 3750 LOCATE 13,23:PRINT "Heat Index Is Also Refered To"
  378. 3760 FOR Z=1 TO 800:NEXT Z
  379. 3770 LOCATE 14,17:PRINT "As The Apparent Temperature.  See The H/I"
  380. 3780 FOR ZXC=1 TO 800:NEXT ZXC
  381. 3790 LOCATE 15,18:PRINT "Explanation & Danger Table For Details."
  382. 3800 FOR ZX=1 TO 1600:NEXT ZX
  383. 3810 GOSUB 4150
  384. 3820 IF CLRT$ = "Y" THEN COLOR 11
  385. 3830 LOCATE 19,19:PRINT "APPARENT TEMPERATURE = ";APPTEMP;" ";U$
  386. 3840 IF DF<0 THEN GOTO 3860
  387. 3850 GOTO 3870
  388. 3860 LOCATE 20,19:PRINT "SEVERE SULTRINESS..."
  389. 3870 IF CLRT$ = "Y" THEN COLOR 7,0,0
  390. 3880 LOCATE 23,19:INPUT "RUN ANOTHER HEAT INDEX FACTOR (Y/N)";L$
  391. 3890 IF L$="Y" OR L$="y" THEN GOTO 3610
  392. 3900 LOCATE 24,16:INPUT "View H/I  Explanation & Danger Table? (Y/N)";CT$
  393. 3910 IF CT$="N" OR CT$="n" THEN GOTO 4140
  394. 3920 IF CLRT$ = "Y" THEN COLOR 14,1,1
  395. 3930 CLS
  396. 3940 PRINT "  "
  397. 3950 PRINT "       Your Present Calculated Heat Index Value Is" APPTEMP" "U$"."
  398. 3960 PRINT "  "
  399. 3970 PRINT "       When the  Heat Index reaches 130 degrees or higher, Heat"
  400. 3980 PRINT "       Strokes or  Sunstrokes are  HIGHLY likely with continued"
  401. 3990 PRINT "       exposure!   When the  Heat Index  ranges from 105 to 130"
  402. 4000 PRINT "       degrees,  sunstroke, heat exhaustion and heat cramps are"
  403. 4010 PRINT "       likely with  prolonged exposure and/or physical activity."
  404. 4020 PRINT "       Heat Index  ranges between 90 and 105 degrees indicate a"
  405. 4030 PRINT "       possibility  of  heat  cramps and  heat  exhaustion with"
  406. 4040 PRINT "       prolonged  exposure and/or physical activity."
  407. 4050 PRINT "  "
  408. 4060 PRINT "       Program calculations assume an adult, wearing long pants"
  409. 4070 PRINT "       and a  short sleeved shirt,  walking in shade at 3.1 MPH"
  410. 4080 PRINT "       with standard sea level air pressure,  a wind  speed  of"
  411. 4090 PRINT "       5.6 MPH, and a vapor pressure of 1.6kPa.  In effect, the"
  412. 4100 PRINT "       calculations  approximate the temperature  that  current"
  413. 4110 PRINT "       conditions feel like to the average person."
  414. 4120 PRINT "  "
  415. 4130 IF CLRT$ = "Y" THEN COLOR 7,0,0
  416. 4140 RETURN
  417. 4150 TC=TA
  418. 4160 IF U$="F" OR U$="f" THEN TC=(TA-32)*5/9
  419. 4170 ES=6.11*10^((7.567*TC)/(239.7+TC))
  420. 4180 E=.01*RH*ES
  421. 4190 GOTO 4230
  422. 4200 IF DF<0 THEN GOTO 4530
  423. 4210 IF U$="F" OR U$="f" THEN APPTEMP=32+1.8*APPTEMP
  424. 4220 RETURN
  425. 4230 TB=37:PB=5.65:Q=180:RS=.0387
  426. 4240 ZS=.0521:EHC=17.4:PHI2=.84
  427. 4250 R=.124:CHC=11.6:PINF=.1*E
  428. 4260 HER=4.18+.036*TC
  429. 4270 ERA=1/(EHC+HER)
  430. 4280 QV=Q*(.143-.00112*TC-.0168*PINF)
  431. 4290 EZA=.060606/EHC
  432. 4300 HR=3.35+.049*TC
  433. 4310 ARA=1/(CHC+HR)
  434. 4320 AZA=.060606/CHC
  435. 4330 Q2U=((TB-TC)+(PB-PINF)*ERA/(ZS+EZA))/(RS+ERA)
  436. 4340 QJ=(Q-QV-(1-PHI2)*Q2U)/PHI2
  437. 4350 K=(RS+ARA)+(ZS+AZA)/R-((TB-TC)+(PB-PINF)/R)/QJ
  438. 4360 L=(RS+ARA)*(ZS+AZA)
  439. 4370 L=(L-((TB-TC)*(ZS+AZA)+(PB-PINF)*ARA)/QJ)/R
  440. 4380 F=K*K-4*L
  441. 4390 IF F<0 THEN DF=-1
  442. 4400 IF F<0 THEN GOTO 4200
  443. 4410 RF=.5*(-K+SQR(F))
  444. 4420 DF=60*RF
  445. 4430 IF DF<0 THEN GOTO 4200
  446. 4440 W1=.2016
  447. 4450 W2=(1-PHI2)/(RS+ERA)
  448. 4460 W3=PHI2/(RS+RF+ARA)
  449. 4470 W4=159.0984
  450. 4480 W5=37
  451. 4490 W6=4.05*ERA/(ZS+EZA)
  452. 4500 W7=4.05*(RF+ARA)/(ZS+R*RF+AZA)
  453. 4510 APPTEMP=(-W4+W2*(W5+W6)+W3*(W5+W7))/(W1+W2+W3)
  454. 4520 GOTO 4200
  455. 4530 HC=12.3:HR=4.1+.028*TC
  456. 4540 RA=1/(HC+HR):ZA=.060606/HC
  457. 4550 QU=Q-QV
  458. 4560 FOR IT=1 TO 10
  459. 4570 ZS=((PB-PINF)*RA)/(QU*(RS+RA)-(TB-TC))-ZA
  460. 4580 IF ZS<0 THEN ZS=0
  461. 4590 R3=(ZS/600000!)^.2
  462. 4600 C=ABS(RS-R3)
  463. 4610 IF C<=.0001 THEN GOTO 4640
  464. 4620 RS=.5*(RS+R3)
  465. 4630 NEXT IT
  466. 4640 N1=159.0984:N2=37:N3=4.05*RA/(ZS+ZA)
  467. 4650 N4=(RS+RA):N5=.2016
  468. 4660 APPTEMP=(-N1+(N2+N3)/N4)/(N5+1/N4)
  469. 4670 GOTO 4210
  470. 4680 REM
  471. 4690 REM     TEMP-HUMIDITY INDEX SUBROUTINE
  472. 4700 REM
  473. 4710 CLS:IF CLRT$ = "Y" THEN COLOR 12
  474. 4720 LOCATE 2,26:PRINT "TEMPERATURE HUMIDITY INDEX"
  475. 4730 IF CLRT$ = "Y" THEN COLOR 5
  476. 4740 LOCATE 4,34:PRINT DATE$:LOCATE 5,35:PRINT TIME$
  477. 4750 IF CLRT$ = "Y" THEN COLOR 3,0,0
  478. 4760 KEY OFF:LOCATE 7,24:PRINT "THE TEMPERATURE HUMIDITY INDEX"
  479. 4770 LOCATE 8,21:PRINT "DETERMINES THE EFFECTIVE TEMPERATURE"
  480. 4780 LOCATE 11,12:INPUT "ENTER THE TEMPERATURE IN FAHRENHEIT                 ";T
  481. 4790 LOCATE 12,12:INPUT "ENTER THE RELATIVE HUMIDITY                         ";H
  482. 4800 LOCATE 15,15:PRINT "PLEASE WAIT - EFFECTIVE TEMPERATURE BEING COMPUTED"
  483. 4810 LOCATE 18,30:FOR C=1 TO 16
  484. 4820 IF CLRT$ = "Y" THEN COLOR (C):PRINT "!!!!!!!!!!!!!!!!!!!"
  485. 4830 LOCATE 18,30:C=C+1
  486. 4840 FOR Z=1 TO 400:NEXT Z
  487. 4850 NEXT C
  488. 4860 IF CLRT$ = "Y" THEN COLOR 3,0,0
  489. 4870 LOCATE 18,25:PRINT "                                   "
  490. 4880 IF H>94 THEN A=((.195*T)-15) ELSE IF H>89 AND H<95 THEN A=((.18*T)-15)
  491. 4890 IF H>79 AND H<90 THEN A=((.1667*T)-15) ELSE IF H>69 AND H<80 THEN A=((.145*T)-15)
  492. 4900 IF H>59 AND H<70 THEN A=((.1233*T)-15) ELSE IF H<60 THEN A=((.085*T)-15)
  493. 4910 TH=(((.8*T)+15)+A)
  494. 4920 IF CLRT$ = "Y" THEN COLOR 13
  495. 4930 LOCATE 20,10:PRINT "THE TEMPERATURE HUMIDITY INDEX =  ";TH;"DEGREES FAHRENHEIT"
  496. 4940 IF CLRT$ = "Y" THEN COLOR 7,0,0
  497. 4950 LOCATE 23,17:INPUT "ANOTHER TEMPERATURE HUMIDITY INDEX (Y/N)";L$
  498. 4960 IF L$="Y" OR L$="y" THEN GOTO 4710
  499. 4970 LOCATE 24,16:INPUT "View THI Explanation & Comfort Table? (Y/N)";CT$
  500. 4980 IF CT$="N" OR CT$="n" THEN GOTO 5000
  501. 4990 GOTO 5010
  502. 5000 RETURN
  503. 5010 IF CLRT$ = "Y" THEN COLOR 14,1,1
  504. 5020 CLS:PRINT "  "
  505. 5030 PRINT "    Your Temperature-Humidity Index reading was "TH"."
  506. 5040 PRINT "  "
  507. 5050 PRINT "    Readings in excess of  70  represent the point  where a few people"
  508. 5060 PRINT "    begin  to  feel  uncomfortable.   Over 75, about 1/2 of all people"
  509. 5070 PRINT "    will feel uncomfortable. Nearly all people will feel uncomfortable"
  510. 5080 PRINT "    with  readings  over  79  with rapidly  decreasing work efficiency"
  511. 5090 PRINT "    begining  with  levels  in excess of  84;  and EXTREME DANGER with"
  512. 5100 PRINT "    possibility of heat  exhaustion  and heat stroke begin with levels"
  513. 5110 PRINT "    of 92 and higher."
  514. 5120 PRINT "  "
  515. 5130 PRINT "    The THI number, used to express the  combined temperature-humidity"
  516. 5140 PRINT "    effect provides a fairly good index of equivalent heat stress.  In"
  517. 5150 PRINT "    engineering, this combined index is refered to as `effective temp-"
  518. 5160 PRINT "    erature'. The weather bureau has also been known to refer to it as"
  519. 5170 PRINT "    the Discomfort Index.  It is NOT the same as the `Heat Index' even"
  520. 5180 PRINT "    though they both help to compute `Appearant' Temperatures.
  521. 5190 PRINT "  "
  522. 5200 PRINT "  "
  523. 5210 IF CLRT$ = "Y" THEN COLOR 7,0,0
  524. 5220 RETURN
  525. 5230 REM
  526. 5240 REM     DEW POINT SUBROUTINE
  527. 5250 REM
  528. 5260 CLS:IF CLRT$ = "Y" THEN COLOR 10
  529. 5270 LOCATE 2,28:PRINT "DEW POINT CALCULATION"
  530. 5280 IF CLRT$ = "Y" THEN COLOR 5
  531. 5290 LOCATE 4,34:PRINT DATE$:LOCATE 5,35:PRINT TIME$
  532. 5300 IF CLRT$ = "Y" THEN COLOR 3,0,0
  533. 5310 KEY OFF:LOCATE 7,12
  534. 5320 INPUT "ENTER TEMPERATURE IN FAHRENHEIT                    ";T
  535. 5330 LOCATE 8,12
  536. 5340 INPUT "ENTER THE RELATIVE HUMIDITY (`50' = 50%)           ";DPRH
  537. 5350 T=(T-32)*5/9
  538. 5360 X=1-(.01*DPRH)
  539. 5370 TD=T-(14.55+.114*T)*X-((2.5+.007*T)*X)^3-(15.9+.117*T)*X^14
  540. 5380 TD=(TD*9/5)+32
  541. 5390 IF CLRT$ = "Y" THEN COLOR 3
  542. 5400 LOCATE 11,19:PRINT "PLEASE WAIT - DEW POINT BEING COMPUTED"
  543. 5410 FOR ZZ=1 TO 1600:NEXT ZZ
  544. 5420 IF CLRT$ = "Y" THEN COLOR 4
  545. 5430 LOCATE 13,23:PRINT "TF=(T-32)*5/9:X=1-(.01*DPRH)"
  546. 5440 FOR Z=1 TO 800:NEXT Z
  547. 5450 LOCATE 14,9:PRINT "TD=T-(14.55+.114*T)*X-((2.5+.007*T)*X)^3-(15.9+.117*T)*X^14"
  548. 5460 FOR ZXC=1 TO 800:NEXT ZXC
  549. 5470 LOCATE 15,30:PRINT "TD=(TD*9/5)+32"
  550. 5480 FOR ZX=1 TO 1600:NEXT ZX
  551. 5490 IF CLRT$ = "Y" THEN COLOR 13
  552. 5500 LOCATE 19,21:PRINT "DEW POINT CALCULATION = ";TD
  553. 5510 IF CLRT$ = "Y" THEN COLOR 7,0,0
  554. 5520 LOCATE 24,20:INPUT "CALCULATE ANOTHER DEW POINT (Y/N)";L$
  555. 5530 IF L$="Y" OR L$="y" THEN GOTO 5260
  556. 5540 RETURN
  557. 5550 REM     ~~~~~~~~~~LAST LINE OF PROGRAM~~~~~~~~~
  558.